home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
getinfo.fr_
/
getinfo.fr
Wrap
Text File
|
1995-05-01
|
18KB
|
480 lines
VERSION 4.00
Begin VB.Form frmGetInfo
BackColor = &H00C0C0C0&
Caption = "Get ODBC Information"
ClientHeight = 3945
ClientLeft = 1095
ClientTop = 1500
ClientWidth = 5055
Height = 4350
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 3945
ScaleWidth = 5055
Top = 1155
Width = 5175
Begin VB.TextBox txtStatus
BackColor = &H00C0C0C0&
Height = 285
Left = 120
TabIndex = 5
Text = "Select the options you want to include."
Top = 3600
Width = 4815
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 375
Left = 3600
TabIndex = 4
Top = 2760
Width = 1335
End
Begin VB.CommandButton cmdGetInfo
Caption = "&Get Info"
Height = 375
Left = 3600
TabIndex = 3
Top = 600
Width = 1335
End
Begin VB.CommandButton cmdSelection
Caption = "&Unselect All"
Height = 375
Index = 1
Left = 3600
TabIndex = 2
Top = 1920
Width = 1335
End
Begin VB.CommandButton cmdSelection
Caption = "&Select All"
Height = 375
Index = 0
Left = 3600
TabIndex = 1
Top = 1440
Width = 1335
End
Begin VB.ListBox lstGetInfoData
Height = 2955
Left = 120
MultiSelect = 2 'Extended
Sorted = -1 'True
TabIndex = 0
Top = 360
Width = 3255
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "SQLGetInfo Options:"
Height = 195
Left = 120
TabIndex = 6
Top = 120
Width = 1470
End
End
Attribute VB_Name = "frmGetInfo"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'tell to put in calls to ODBCError after calls to SQLGetInfo if having problems
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdGetInfo_Click()
Dim selCount As Integer 'count of selected items
Dim i As Integer, j As Integer
'Return value types
Dim ri As Integer
Dim rs As String * 255
Dim rb As Long
Dim rl As Long
Dim rgbInfoValue As Long
Dim cbInfoValueMax As Integer
Dim pcbInfoValue As Integer
Dim result As Integer
Dim temp As String
Dim ConnIndex As Integer
Dim cdID As String
Dim errMsg As String
Dim RowData() As String
cbInfoValueMax = 255
'Get the number of rows selected and the type of data
selCount = 0
For i = 0 To lstGetInfoData.ListCount - 1
If lstGetInfoData.Selected(i) Then
ReDim Preserve RowData(selCount + 1)
RowData(selCount) = lstGetInfoData.List(i)
selCount = selCount + 1
End If
Next
If selCount = 0 Then
MsgBox "No attributes were selected. Please select at least one and try again.", MB_ICONEXCLAMATION
Exit Sub
End If
'Start by clearing the frmODBC grid
frmODBC.grdResults.Rows = selCount + 1
frmODBC.grdResults.Cols = 3
frmODBC.grdResults.FixedCols = 1
frmODBC.grdResults.FixedRows = 1
frmODBC.grdResults.ColWidth(0) = 8
frmODBC.grdResults.ColWidth(1) = 0.45 * frmODBC.grdResults.Width
frmODBC.grdResults.ColWidth(2) = 0.55 * frmODBC.grdResults.Width
frmODBC.grdResults.Row = 0
frmODBC.grdResults.Col = 1
frmODBC.grdResults.text = "Attribute Constant"
frmODBC.grdResults.Col = 2
frmODBC.grdResults.text = "Value"
frmODBC.lblGrid.Caption = frmODBC.lstODBCdbs.text & " " & "Properties"
For i = 0 To selCount - 1
frmODBC.grdResults.Row = i + 1
frmODBC.grdResults.Col = 0
frmODBC.grdResults.text = i + 1
frmODBC.grdResults.Col = 1
frmODBC.grdResults.text = RowData(i)
frmODBC.grdResults.Col = 2
'Get the index of ODBConn - have to do it this way
'because there are gaps in the ODBC constants
For j = 0 To UBound(ODBCGetInfo)
If RowData(i) = ODBCGetInfo(j).InfoType Then
'j now equals the index
Exit For
End If
Next
'Format the data according the return type of
'ODBCGetInfo
Select Case Left$(ODBCGetInfo(j).ReturnType, 1)
Case "S" 'String
result = SQLGetInfo(ghDbc, j, ByVal rs, Len(rs), pcbInfoValue)
If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
frmODBC.grdResults.text = SpecialStr(RowData(i), Trim$(rs))
Else
frmODBC.grdResults.text = Trim$(rs)
End If
Case "B" '32-bit Bitmask
result = SQLGetInfo(ghDbc, j, rb, 255, pcbInfoValue)
frmODBC.grdResults.text = BitMask(rb)
Case "I" 'Integer
result = SQLGetInfo(ghDbc, j, ri, 255, pcbInfoValue)
If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
frmODBC.grdResults.text = SpecialInt(RowData(i), Trim$(ri))
Else
frmODBC.grdResults.text = ri
End If
Case "L" 'Long
result = SQLGetInfo(ghDbc, j, rl, 255, pcbInfoValue)
If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
frmODBC.grdResults.text = SpecialLong(RowData(i), Trim$(rl))
Else
frmODBC.grdResults.text = rl
End If
Case Else
'Error in array
frmODBC.grdResults.text = "Error processing return value."
End Select
If result <> SQL_SUCCESS Then
frmODBC.grdResults.text = "Error getting data."
End If
Next
frmODBC.grdResults.Visible = True
Unload Me
End Sub
Private Sub cmdSelection_Click(Index As Integer)
'Select all of the items in the list
Dim i As Integer
For i = 0 To lstGetInfoData.ListCount - 1
lstGetInfoData.Selected(i) = IIf(Index, False, True)
Next
End Sub
Private Sub Form_Load()
'Load the list box with the ODBCGetInfo array
Dim i As Integer
For i = 0 To SQL_INFO_LAST
If ODBCGetInfo(i).InfoType <> "" Then
lstGetInfoData.AddItem ODBCGetInfo(i).InfoType
End If
Next
frmGetInfo.Move (Screen.Width - frmGetInfo.Width) / 2, (Screen.Height - frmGetInfo.Height) / 2
frmGetInfo.Show
End Sub
Private Function SpecialStr(Opt As String, RetStr As String)
'Do any special processing required for a SQLGetInfo string
Select Case Opt
Case "SQL_ODBC_SQL_OPT_IEF"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_COLUMN_ALIAS"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_KEYWORDS"
SpecialStr = "List of keywords." '&&&
Case "SQL_ORDER_BY_COLUMNS_IN_SELECT"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_MAX_ROW_SIZE_INCLUDES_LONG"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_EXPRESSIONS_IN_ORDERBY"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_MULT_RESULT_SETS"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_OUTER_JOINS"
Select Case RetStr
Case "N"
SpecialStr = "No outer joins."
Case "Y"
SpecialStr = "Yes, left-right segregation."
Case "P"
SpecialStr = "Partial outer joins."
Case "F"
SpecialStr = "Full outer joins."
Case Else
SpecialStr = "Missing data."
End Select
Case "SQL_NEED_LONG_DATA_LEN"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_LIKE_ESCAPE_CLAUSE"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_ACCESSIBLE_PROCEDURES"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_ACCESSIBLE_TABLES"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_DATA_SOURCE_READ_ONLY"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_PROCEDURES"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case "SQL_ROW_UPDATES"
SpecialStr = IIf(RetStr = "Y", "Yes", "No")
Case Else
SpecialStr = "Missing special processing."
End Select
End Function
Private Function SpecialInt(Opt As String, RetInt As Integer)
'Do any special processing required for a SQLGetInfo integer
Select Case Opt
Case "SQL_CORRELATION_NAME"
Select Case RetInt
Case SQL_CN_NONE
SpecialInt = "Not supported."
Case SQL_CN_DIFFERENT
SpecialInt = "Supported but names vary."
Case SQL_CN_ANY
SpecialInt = "Any valid user name."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_NON_NULLABLE_COLUMNS"
Select Case RetInt
Case SQL_NNC_NULL
SpecialInt = "All columns nullable."
Case SQL_NNC_NON_NULL
SpecialInt = "May be non-nullable."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_FILE_USAGE"
Select Case RetInt
Case SQL_FILE_NOT_SUPPORTED
SpecialInt = "Not a single tier driver."
Case SQL_FILE_TABLE
SpecialInt = "Treats data source as table."
Case SQL_FILE_QUALIFIER
SpecialInt = "Treats data source as qualifier."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_NULL_COLLATION"
Select Case RetInt
Case SQL_NC_END
SpecialInt = "NULLs sorted to end."
Case SQL_NC_HIGH
SpecialInt = "NULLs sorted to high end."
Case SQL_NC_LOW
SpecialInt = "NULLs sorted to low end."
Case SQL_NC_START
SpecialInt = "NULLs sorted to start."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_GROUP_BY"
Select Case RetInt
Case SQL_GB_NOT_SUPPORTED
SpecialInt = "Group By not supported."
Case SQL_GB_GROUP_BY_EQUALS_SELECT
SpecialInt = "All non-aggregated columns, no others."
Case SQL_GB_GROUP_BY_CONTAINS_SELECT
SpecialInt = "All non-aggregated columns, some others."
Case SQL_GB_NO_RELATION
SpecialInt = "Not related to select list."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_IDENTIFIER_CASE"
Select Case RetInt
Case SQL_IC_UPPER
SpecialInt = "Upper case."
Case SQL_IC_LOWER
SpecialInt = "Lower case."
Case SQL_IC_SENSITIVE
SpecialInt = "Case sensitive."
Case SQL_IC_MIXED
SpecialInt = "Mixed case."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_QUOTED_IDENTIFIER_CASE"
Select Case RetInt
Case SQL_IC_UPPER
SpecialInt = "Upper case."
Case SQL_IC_LOWER
SpecialInt = "Lower case."
Case SQL_IC_SENSITIVE
SpecialInt = "Case sensitive."
Case SQL_IC_MIXED
SpecialInt = "Mixed case."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_ODBC_API_CONFORMANCE"
Select Case RetInt
Case SQL_OAC_NONE
SpecialInt = "No conformance."
Case SQL_OAC_LEVEL1
SpecialInt = "Level 1 supported."
Case SQL_OAC_LEVEL2
SpecialInt = "Level 2 supported."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_CURSOR_COMMIT_BEHAVIOR"
Select Case RetInt
Case SQL_CB_DELETE
SpecialInt = "Close and delete statements."
Case SQL_CB_CLOSE
SpecialInt = "Close cursors."
Case SQL_CB_PRESERVE
SpecialInt = "Preserve cursors."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_CURSOR_ROLLBACK_BEHAVIOR"
Select Case RetInt
Case SQL_CB_DELETE
SpecialInt = "Close and delete statements."
Case SQL_CB_CLOSE
SpecialInt = "Close cursors."
Case SQL_CB_PRESERVE
SpecialInt = "Preserve cursors."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_TXN_CAPABLE"
Select Case RetInt
Case SQL_TC_NONE
SpecialInt = "Transactions not supported."
Case SQL_TC_DML
SpecialInt = "DML statements only, DDL cause error."
Case SQL_TC_DDL_COMMIT
SpecialInt = "DML statements, DDL commit transaction."
Case SQL_TC_DDL_IGNORE
SpecialInt = "DML statements, DDL ignored."
Case SQL_TC_ALL
SpecialInt = "Both DML and DDL statements."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_QUALIFIER_LOCATION"
Select Case RetInt
Case SQL_QL_START
SpecialInt = "Start of name."
Case SQL_QL_END
SpecialInt = "End of name."
Case Else
SpecialInt = "Missing data."
End Select
Case "SQL_CONCAT_NULL_BEHAVIOR"
Select Case RetInt
Case SQL_CB_NULL
SpecialInt = "Result is NULL valued."
Case SQL_CB_NON_NULL
SpecialInt = "Result is non-NULL concatenation."
Case Else
SpecialInt = "Missing data."
End Select
Case Else
SpecialInt = "Missing special integer processing."
End Select
End Function
Private Function BitMask(RetBit As Long)
'Do processing required for a SQLGetInfo bit mask return
Dim i As Long, bin As String
Const maxpower = 30 ' Maximum number of binary digits supported.
bin = "" 'Build the desired binary number in this string, bin.
If RetBit > 2 ^ maxpower Then
BitMask = "Error converting data."
Exit Function
End If
' Negative numbers have "1" in the 32nd left-most digit:
If RetBit < 0 Then bin = bin + "1" Else bin = bin + "0"
For i = maxpower To 0 Step -1
If RetBit And (2 ^ i) Then ' Use the logical "AND" operator.
bin = bin + "1"
Else
bin = bin + "0"
End If
Next
BitMask = bin ' The bin string contains the binary number.
End Function
Private Function SpecialLong(Opt As String, RetInt As Integer)
'Do any special processing required for a SQLGetInfo long
Select Case Opt
Case "SQL_DEFAULT_TXN_ISOLATION"
Select Case RetInt
Case SQL_TXN_READ_UNCOMMITTED
SpecialLong = "Dirty reads, nonrepeatable, phantoms."
Case SQL_TXN_READ_COMMITTED
SpecialLong = "No dirty reads, but nonrepeatable and phantoms."
Case SQL_TXN_REPEATABLE_READ
SpecialLong = "No dirty or nonrepeatable reads. Phantoms okay."
Case SQL_TXN_SERIALIZABLE
SpecialLong = "Serializable transactions."
Case SQL_TXN_VERSIONING
SpecialLong = "Serializable transactions with higher concurrency."
Case Else
SpecialLong = "Missing data."
End Select
Case Else
SpecialLong = "Missing special Long processing."
End Select
End Function